home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok38 / coco / demo / errors.mod < prev    next >
Encoding:
Modula Implementation  |  1993-11-04  |  6.9 KB  |  219 lines
  1. (* Errors       General module to store error messages   Moe 21.03.84
  2.    ======       ======================================
  3. This module stores information about syntax errors and semantic errors.
  4. The information can either be retrieved afterwards or or be printed
  5. automatically as simple error messages.
  6. Furthermore the module contains procedures to report compiler errors
  7. and implementation restrictions. These procedures cause a program stop.
  8. ----------------------------------------------------------------------*)
  9. IMPLEMENTATION MODULE Errors;
  10.  
  11. (*imports of definition module*)
  12. FROM FileSystem IMPORT File;
  13.  
  14. (*imports of implementation module*)
  15. FROM FileIO  IMPORT con, Write, WriteCard, WriteLn, WriteString, WriteText;
  16. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  17.  
  18.  
  19. TYPE
  20.   Semerrptr = POINTER TO Semerror;
  21.   Semerror  = RECORD
  22.     nr,line,col: CARDINAL;
  23.     next: Semerrptr;
  24.     END;
  25.   Synerrptr = POINTER TO Synerror;
  26.   Synerror  = RECORD
  27.     symbols: Errorptr;
  28.     line,col: CARDINAL;
  29.     next: Synerrptr;
  30.     END;
  31.  
  32. VAR
  33.   semerr: Semerrptr;
  34.   synerr: Synerrptr;
  35.  
  36.  
  37. (* CompErr      Reports compiler error nr and stops the program
  38. ----------------------------------------------------------------------*)
  39. PROCEDURE CompErr(nr:CARDINAL);
  40. VAR dummy:CARDINAL;
  41. BEGIN
  42.   PrintSynErrors(con,dummy); PrintSemErrors(con,dummy);
  43.   WriteString(con,"Compiler error "); WriteCard(con,nr,0);
  44.   WriteString(con,". Program terminated.$");
  45.   HALT;                                     (*25.11.,C,Dob*)
  46.   END CompErr;
  47.  
  48.  
  49. (* GetNextSemErr     Gets next semantic error information
  50. -----------------------------------------------------------------------*)
  51. PROCEDURE GetNextSemErr(VAR nr,line,col:CARDINAL);
  52. VAR p: Semerrptr;
  53. BEGIN
  54.   IF semerr=NIL
  55.     THEN nr:=0; line:=0; col:=0;
  56.     ELSE
  57.       p:=semerr;
  58.       nr:=p^.nr; line:=p^.line; col:=p^.col;
  59.       semerr:=p^.next; DEALLOCATE(p, 0);
  60.       END;
  61.   END GetNextSemErr;
  62.  
  63.  
  64. (* GetNextSynErr     Gets next syntax error information
  65. ------------------------------------------------------------------------*)
  66. PROCEDURE GetNextSynErr(VAR symbols:Errorptr; VAR line,col:CARDINAL);
  67. VAR p: Synerrptr;
  68. BEGIN
  69.   IF synerr=NIL
  70.     THEN symbols:=NIL; line:=0; col:=0;
  71.     ELSE
  72.       p:=synerr;
  73.       symbols:=p^.symbols; line:=p^.line; col:=p^.col;
  74.       synerr:=p^.next; DEALLOCATE(p, 0);
  75.       END;
  76.   END GetNextSynErr;
  77.  
  78.  
  79. (* GetNumberOfErrors    Gets the total number of errors that occured
  80. -----------------------------------------------------------------------*)
  81. PROCEDURE GetNumberOfErrors(VAR synerrors,semerrors:CARDINAL);
  82. VAR
  83.   syn: Synerrptr;
  84.   sem: Semerrptr;
  85. BEGIN
  86.   synerrors:=0; syn:=synerr;
  87.   WHILE syn<>NIL DO INC(synerrors); syn:=syn^.next; END;
  88.   semerrors:=0; sem:=semerr;
  89.   WHILE sem<>NIL DO INC(semerrors); sem:=sem^.next; END;
  90.   END GetNumberOfErrors;
  91.  
  92.  
  93. (* PrintSemErrors      Prints simple error messages for semantic errors
  94. ------------------------------------------------------------------------*)
  95. PROCEDURE PrintSemErrors(VAR f:File; VAR semerrors:CARDINAL);
  96. VAR
  97.   p:         Semerrptr;
  98.   synerrors: CARDINAL;
  99. BEGIN
  100.   GetNumberOfErrors(synerrors,semerrors);
  101.   IF semerrors>0 THEN
  102.     WriteString(f,"Semantic errors:$$");
  103.     p:=semerr;
  104.     WHILE p<>NIL DO
  105.       WriteString(f,"line"); WriteCard(f,p^.line,5);
  106.       WriteString(f," col"); WriteCard(f,p^.col,3);
  107.       WriteString(f,": error "); WriteCard(f,p^.nr,0);
  108.       WriteLn(f);
  109.       p:=p^.next;
  110.       END;
  111.     END;
  112.   END PrintSemErrors;
  113.  
  114.  
  115. (* PrintSynErrors      Prints simple error messages for syntax errors
  116. ------------------------------------------------------------------------*)
  117. PROCEDURE PrintSynErrors(VAR f:File; VAR synerrors:CARDINAL);
  118. CONST
  119.   llinit  = 18;             (*initial linelength*)
  120.   linelen = 10;             (*length of line number printing*)
  121.   llmax   = 71;             (*maximal line length*)
  122. VAR
  123.   err,err1:  Synerrptr;
  124.   p,q:       Errorptr;
  125.   ll:        CARDINAL;          (*line length*)
  126.   i:         CARDINAL;
  127.   first:     BOOLEAN;
  128.   semerrors: CARDINAL;
  129. BEGIN
  130.   GetNumberOfErrors(synerrors,semerrors);
  131.   IF synerrors>0 THEN
  132.     WriteString(f,"Syntax errors:$$");
  133.     err:=synerr;
  134.     WHILE err<>NIL DO
  135.       WriteString(f,'line'); WriteCard(f,err^.line,5);
  136.       p:=err^.symbols;
  137.       IF p=NIL THEN  (*simple error message*)
  138.         WriteString(f," column"); WriteCard(f,err^.col,4); WriteLn(f);
  139.         RETURN;
  140.         END;
  141.       WriteString(f,' near '); WriteText(f,p^.txt,p^.l); WriteString(f,' : ');
  142.       ll:=llinit+p^.l; p:=p^.next; first:=TRUE;
  143.       WHILE p<>NIL DO
  144.         IF first
  145.           THEN first:=FALSE
  146.           ELSE                          (*print separator*)
  147.             IF p^.next=NIL
  148.               THEN WriteString(f,' or '); ll:=ll+4;   (*or*)
  149.               ELSE WriteString(f,', '); ll:=ll+2;     (*, *)
  150.               END
  151.             END;
  152.         IF ll+p^.l>llmax THEN  (*skip to next line*)
  153.           WriteLn(f); ll:=linelen;
  154.           FOR i:=1 TO linelen DO Write(f,' '); END;
  155.           END;
  156.         IF p^.l=1              (*print symbol*)
  157.           THEN                           (*in quotes*)
  158.             Write(f,'"'); Write(f,p^.txt[1]); Write(f,'"');
  159.             ll:=ll+p^.l+2;
  160.           ELSE                           (*without quotes*)
  161.             WriteText(f,p^.txt,p^.l);
  162.             ll:=ll+p^.l;
  163.             END;
  164.         q:=p; p:=p^.next; DEALLOCATE(q, 0);
  165.         END;
  166.       WriteString(f,' expected'); WriteLn(f);
  167.       err1:=err; err:=err^.next; DEALLOCATE(err1, 0);
  168.       END;
  169.     END;
  170.   END PrintSynErrors;
  171.  
  172.  
  173. (* Restriction Reports implementation restriction nr and stops the program
  174. ----------------------------------------------------------------------*)
  175. PROCEDURE Restriction(nr:CARDINAL);
  176. VAR dummy:CARDINAL;
  177. BEGIN
  178.   PrintSynErrors(con,dummy); PrintSemErrors(con,dummy);
  179.   WriteString(con,"Implementation restriction "); WriteCard(con,nr,0);
  180.   WriteString(con,". Program terminated.$");
  181.   HALT;                                     (*25.11.,C,Dob*)
  182.   END Restriction;
  183.  
  184.  
  185. (* SemErr         Stores information about semantic error
  186. ----------------------------------------------------------------------*)
  187. PROCEDURE SemErr(nr,line,col:CARDINAL);
  188. VAR e,p,q: Semerrptr;
  189. BEGIN
  190.   ALLOCATE(e, SIZE(e^)); e^.nr:=nr; e^.line:=line; e^.col:=col;
  191.   p:=semerr; q:=NIL;
  192.   WHILE (p<>NIL) AND (p^.line<line) DO q:=p; p:=p^.next; END;
  193.   WHILE (p<>NIL) AND (p^.line=line) AND (p^.col<col) DO
  194.     q:=p; p:=p^.next;
  195.     END;
  196.   IF q=NIL THEN semerr:=e; ELSE q^.next:=e; END;
  197.   e^.next:=p;
  198.   END SemErr;
  199.  
  200.  
  201. (* SyntaxError         Stores information about syntax error
  202. ----------------------------------------------------------------------*)
  203. PROCEDURE SyntaxError(symbols:Errorptr; line,col:CARDINAL);
  204. VAR e,p,q: Synerrptr;
  205. BEGIN
  206.   ALLOCATE(e, SIZE(e^)); e^.symbols:=symbols; e^.line:=line; e^.col:=col;
  207.   p:=synerr; q:=NIL;
  208.   WHILE (p<>NIL) AND (p^.line<line) DO q:=p; p:=p^.next; END;
  209.   WHILE (p<>NIL) AND (p^.line=line) AND (p^.col<col) DO
  210.     q:=p; p:=p^.next;
  211.     END;
  212.   IF q=NIL THEN synerr:=e; ELSE q^.next:=e; END;
  213.   e^.next:=p;
  214.   END SyntaxError;
  215.  
  216. BEGIN  (*Errors*)
  217.   synerr:=NIL; semerr:=NIL;
  218.   END Errors.
  219.